home *** CD-ROM | disk | FTP | other *** search
/ HAM Radio 1997 / HAM Radio 1997.iso / vcls / compress / compmain.pas < prev    next >
Pascal/Delphi Source File  |  1996-04-08  |  23KB  |  660 lines
  1. (*
  2.   CompDemo V1.5 for TCompress Components V1.5
  3.  
  4.   You are free to amend, adjust, improve, update, borrow, alter and muck about
  5.   with this demonstration program at will.
  6.  
  7.   However, if you redistribute the amended source together with the TCompress
  8.   components, please be sure to include ALL the files that came with it
  9.   (incl. Compress.hlp, Readme.txt and the ORIGINAL COMPDEMO source).  Thanks.
  10.  
  11.   Hint: To find the code which makes use of the TCompress components, search
  12.   for Compress1, CDBImage1 and CDBMemo1 references...
  13.  
  14.   Enjoy.
  15. *)
  16.  
  17. {$D-}   { Don't need debugging info, thanks... }
  18. unit Compmain;
  19.  
  20. interface
  21.  
  22. uses
  23.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  24.   Forms, Dialogs, Compress, StdCtrls, DB, DBTables, DBCtrls,
  25.   CompCtrl, ExtCtrls, Buttons, FileCtrl, Mask;
  26.  
  27. type
  28.   TForm1 = class(TForm)
  29.     Table1: TTable;
  30.     DBNavigator1: TDBNavigator;
  31.     DataSource1: TDataSource;
  32.     Compress1: TCompress;
  33.     Table1SpeciesNo: TFloatField;
  34.     Table1Category: TStringField;
  35.     Table1Common_Name: TStringField;
  36.     Table1SpeciesName: TStringField;
  37.     Table1Lengthcm: TFloatField;
  38.     Table1Length_In: TFloatField;
  39.     CDBImage1: TCDBImage;
  40.     CDBMemo1: TCDBMemo;
  41.     CMethod: TRadioGroup;
  42.     Memo2: TMemo;
  43.     Shape1: TShape;
  44.     GroupBox1: TGroupBox;
  45.     FL: TFileListBox;
  46.     DL: TDirectoryListBox;
  47.     DCB: TDriveComboBox;
  48.     ArchiveGroup: TGroupBox;
  49.     ArchiveLabel: TLabel;
  50.     archivefile: TEdit;
  51.     Label2: TLabel;
  52.     ListBox1: TListBox;
  53.     Fishname: TDBEdit;
  54.     Memo4: TMemo;
  55.     Memo3: TMemo;
  56.     Memo5: TMemo;
  57.     Memo6: TMemo;
  58.     DBText1: TDBText;
  59.     Memo1: TMemo;
  60.     Button1: TButton;
  61.     Panel1: TPanel;
  62.     Bevel1: TBevel;
  63.     Time: TLabel;
  64.     Percentage: TLabel;
  65.     TimeLabel: TLabel;
  66.     Label7: TLabel;
  67.     Trashcan: TImage;
  68.     Image1: TImage;
  69.     Button2: TButton;
  70.     procedure CompressOneFile(var fname: String);
  71.     procedure ResetFileInfo;
  72.     function GetDir: string;
  73.     function GetDummyFilename(generatefrom: string; ext: string): string;
  74.     procedure handleDropField(Source: TObject; archivetoo: Boolean);
  75.     procedure CompressFiles;
  76.     procedure CheckArchiveFile;
  77.     function getCompressionMethod: TCompressionMethod;
  78.     procedure showInfo;
  79.     procedure FormCreate(Sender: TObject);
  80.     procedure showfiles;
  81.     procedure ExpandDelete(Operation: TCProcessMode; All: Boolean);
  82.     procedure archivefileChange(Sender: TObject);
  83.     procedure CMethodClick(Sender: TObject);
  84.     procedure DLDragOver(Sender, Source: TObject; X, Y: Integer;
  85.       State: TDragState; var Accept: Boolean);
  86.     procedure CDBMemo1DragOver(Sender, Source: TObject; X, Y: Integer;
  87.       State: TDragState; var Accept: Boolean);
  88.     procedure CDBImage1DragOver(Sender, Source: TObject; X, Y: Integer;
  89.       State: TDragState; var Accept: Boolean);
  90.     procedure archivefileDragOver(Sender, Source: TObject; X, Y: Integer;
  91.       State: TDragState; var Accept: Boolean);
  92.     procedure archivefileDragDrop(Sender, Source: TObject; X, Y: Integer);
  93.     procedure DLDragDrop(Sender, Source: TObject; X, Y: Integer);
  94.     procedure TrashcanDragDrop(Sender, Source: TObject; X, Y: Integer);
  95.     procedure FormDestroy(Sender: TObject);
  96.     procedure ListBox1Click(Sender: TObject);
  97.     procedure CDBImage1DragDrop(Sender, Source: TObject; X, Y: Integer);
  98.     procedure CDBMemo1DragDrop(Sender, Source: TObject; X, Y: Integer);
  99.     procedure CDBImage1MouseDown(Sender: TObject; Button: TMouseButton;
  100.       Shift: TShiftState; X, Y: Integer);
  101.     procedure CDBMemo1MouseDown(Sender: TObject; Button: TMouseButton;
  102.       Shift: TShiftState; X, Y: Integer);
  103.     procedure Table1AfterPost(DataSet: TDataset);
  104.     procedure Button1Click(Sender: TObject);
  105.     procedure FLClick(Sender: TObject);
  106.     procedure Compress1CheckFile(var filepath: OpenString;
  107.       mode: TCProcessMode);
  108.     procedure Panel1Click(Sender: TObject);
  109.     procedure FormClick(Sender: TObject);
  110.     procedure GroupBox1Click(Sender: TObject);
  111.     procedure TrashcanDragOver(Sender, Source: TObject; X, Y: Integer;
  112.       State: TDragState; var Accept: Boolean);
  113.     procedure Button2Click(Sender: TObject);
  114.   private
  115.     { Private declarations }
  116.   public
  117.     { Public declarations }
  118.   end;
  119.  
  120. var
  121.   Form1: TForm1;
  122.  
  123. implementation
  124.  
  125. {$R *.DFM}
  126.  
  127. var FileList: TStringList; { holds information about our archive files }
  128.     saveCompressionMethod: Integer; { see ListBox1.click }
  129.  
  130. const ShowFileInfoColor :Tcolor = clGray; { see Listbox1.click }
  131.  
  132. { Example of accessing the TCompress performance properties }
  133. procedure Tform1.showinfo;
  134. begin
  135.    ResetFileInfo;
  136.    Time.caption:=Format('%-5.1fsecs',[Compress1.CompressionTime/1000.0]{[f]});
  137.    Percentage.caption:=IntToStr(Compress1.CompressedPercentage)+'%';
  138. end;
  139.  
  140. { Example of getting a list of files in a multi-file archive }
  141. procedure TForm1.showfiles;
  142. begin
  143.   listbox1.clear;
  144.   FileList.clear;
  145.   if not FileExists(archivefile.Text) then exit;
  146.   Compress1.ScanCompressedFile(ArchiveFile.Text,Filelist);
  147.   ListBox1.Items.addStrings(FileList); { and File info objects are
  148.                             there too -- see ListBox1Click and FormDestroy }
  149. end;
  150.  
  151. { Example of OnCheckFile user interface handling routine }
  152. { Example of expanding/deleting one or more files from a multi-file archive }
  153. procedure TForm1.ExpandDelete(Operation: TCProcessMode; All: Boolean);
  154. var s: Tstringlist;
  155.   count: Integer;
  156. begin
  157.   if (All and (Listbox1.Items.count > 0)) or (Listbox1.selcount>0) then { something is... }
  158.   begin
  159.      s:=Tstringlist.create;
  160.      try
  161.         if All then
  162.            s.addStrings(ListBox1.Items)
  163.         else
  164.            for count :=0 to Listbox1.ITems.count-1 do
  165.             if Listbox1.selected[count] then
  166.               s.add(Listbox1.items[count]);
  167.         if Operation=cmExpand then { expand }
  168.           compress1.expandfiles(ArchiveFile.Text,s)
  169.         else
  170.           compress1.deletefiles(ArchiveFile.Text,s);
  171.         showinfo;
  172.         showfiles; { also clears selections... }
  173.      finally
  174.         s.free;
  175.         Screen.Cursor := crDefault;
  176.      end;
  177.   end;
  178. end;
  179.  
  180. { Example of compressing a SINGLE file into an archive }
  181. procedure TForm1.CompressOneFile(var fname: String);
  182. begin
  183.   Compress1.CompressFile(ArchiveFile.Text,fname,getCompressionMethod);
  184.   showInfo;
  185.   showfiles;
  186.   Screen.Cursor := crDefault;
  187.   DeleteFile(fname); { because for this example we're creating TEMP files only... }
  188. end;
  189.  
  190. { Example of compressing MULTIPLE files into an archive }
  191. procedure TForm1.CompressFiles;
  192. var s: Tstringlist;
  193.     Count: Integer;
  194. begin
  195.   if FL.selcount>0 then { something is... }
  196.   begin
  197.     s:=TStringlist.Create;
  198.     try
  199.       for count :=0 to FL.Items.count-1 do
  200.         if FL.selected[count] then
  201.           s.add(FL.items[count]);
  202.       Compress1.CompressFiles(ArchiveFile.Text,s,getCompressionMethod);
  203.       showInfo;
  204.       showfiles;
  205.     finally;
  206.        s.free;
  207.        Screen.Cursor := crDefault;
  208.     end;
  209.   end;
  210. end;
  211.  
  212. { Examples of setting/loading/shifting image blobs }
  213. procedure TForm1.CDBImage1DragDrop(Sender, Source: TObject; X, Y: Integer);
  214. var filepath: String;
  215.      mem: TMemoryStream; { for loading image from an archived file }
  216. begin
  217.    if Source=Sender then exit; { nowt to do }
  218.    if (Sender is TCDBImage) and (not Table1.active) then
  219.    begin
  220.      showmessage('Can''t do this unless table has been opened...');
  221.      exit;
  222.    end;
  223.  
  224.   Screen.Cursor:= crHourGlass;
  225.   if (Source = Image1) and (Sender is TCDBImage) then
  226.      CDBImage1.picture.bitmap.Assign(Image1.Picture.bitmap)
  227.   else if (Source is TCDBImage) and (Sender = Image1) then
  228.      Image1.picture.bitmap.Assign(CDBImage1.Picture.Bitmap)
  229.   else
  230.   begin   { Have we got an image? }
  231.      filepath := '';
  232.      if (Source is TListBox) and (Listbox1.selcount = 1) then
  233.       filepath:=ListBox1.Items[Listbox1.ItemIndex] { archive list }
  234.      else if (Source is TFileListBox) and (FL.selcount=1) then
  235.         filepath:=FL.Items[FL.ItemIndex]; { file list }
  236.      if ExtractFileExt(filepath)<>'.bmp' then
  237.      begin
  238.         MessageBeep(1);
  239.         showmessage('Must be a .BMP file...')
  240.      end else begin                             { ok, here we go... }
  241.         if Source is TListBox then { must first extract file... }
  242.         begin { Note: Registered users will get the source of two FASTER ways
  243.                                 of going about this (no expanded file needed) }
  244.           Compress1.ExpandFile(filepath,ArchiveFile.Text);
  245.           Screen.cursor := crDefault; { as our OnCheckFile sets it on }
  246.           if filepath='' then exit; { was skipped on confirmation }
  247.         end;
  248.         Screen.Cursor:= crHourGlass;
  249.         if Sender = Image1 then
  250.            Image1.Picture.Bitmap.LoadFromfile(filepath)
  251.         else
  252.            CDBImage1.Picture.Bitmap.LoadFromFile(filepath);
  253.      end; { else }
  254.   end;
  255.   if Table1.active then Table1.post; { save immediately if updated }
  256.   if not Image1.Picture.Bitmap.Empty then Memo1.visible := False; { got a piccy showing... }
  257.   Screen.Cursor:= crDefault;
  258. end;
  259.  
  260. { Examples of setting/loading/shifting CDBMemo blobs }
  261. procedure TForm1.CDBMemo1DragDrop(Sender, Source: TObject; X, Y: Integer);
  262. var filepath: String;
  263.      f: Tfilestream;
  264.      mem: TMemoryStream; { for loading text from an archived file }
  265. begin
  266.  
  267.   filepath := ''; { in case fails }
  268.   if (Source is TListBox) and (Listbox1.selcount = 1) then
  269.    filepath:=ListBox1.Items[Listbox1.ItemIndex] { archive list }
  270.   else if (Source is TFileListBox) and (FL.selcount=1) then
  271.      filepath:=FL.Items[FL.ItemIndex]; { file list }
  272.   if ExtractFileExt(filepath)<>'.txt' then
  273.   begin
  274.     MessageBeep(1);
  275.     showmessage('Must be a .TXT file...')
  276.   end else begin                             { ok, here we go... }
  277.     if Source is TListBox then { must first extract file... }
  278.     begin { Note: Registered users will get the source of two FASTER ways
  279.                             of going about this (no expanded file needed) }
  280.       Compress1.ExpandFile(filepath,ArchiveFile.Text);
  281.       Screen.cursor := crDefault; { as our OnCheckFile sets it on }
  282.       if filepath='' then exit; { was skipped on confirmation }
  283.     end;
  284.     Screen.Cursor:= crHourGlass;
  285.     CDBMemo1.Lines.LoadfromFile(filepath)
  286.   end;
  287.   if Table1.active then Table1.post; { save immediately }
  288.   Screen.Cursor:= crDefault;
  289. end;
  290.  
  291. procedure TForm1.FormCreate(Sender: TObject);
  292. begin
  293.  
  294.  CheckArchiveFile; { old V1.0 archive deletion... }
  295.  fileList := TStringList.create; { keeps track of our archive files for display etc. }
  296.  SendMessage(ListBox1.handle,LB_SetHorizontalExtent,300,LongInt(0));
  297.  saveCompressionMethod := -1; { see Listbox1.click }
  298.  showfiles; { show files in archive (if any)... }
  299.  try
  300.    DL.Directory := '\DELPHI\IMAGES\BACKGRND';
  301.  except on EInOutError do ; { nowt, let it default }
  302.  end;
  303.  
  304.  try Table1.Active := True;
  305.      DataSource1.Edit;
  306.  except
  307.   on EDBEngineError do
  308.      showmessage('The BLOB compression portion of this demonstration'+#13+
  309.                  'requires that the DBDEMOS alias be set up and pointing'+#13+
  310.                  'to the BIOLIFE.DB table in \DELPHI\DEMOS\DATA.'+#13+#13+
  311.                  '-- as this is not currently the case, the BLOB demonstration'+#13+
  312.                  'is disabled.');
  313.   on EUnrecognizedCompressionMethod do
  314.      showmessage('Your BIOLIFE database may have been compressed using the LZW'+#13+
  315.                  'compression in TCompress v1.0. As LZH replaces LZW in V1.5,'+#13+
  316.                  'please revert to an uncompressed backup of BIOLIFE.*, or use the'+#13+
  317.                  'LZW source which comes with registered versions of TCompress v1.5.');
  318.  end; {try }
  319.  
  320.  if not Table1.Active then { something went wrong... }
  321.  begin
  322.      CDBImage1.visible:=False;
  323.      CDBMemo1.visible:=False;
  324.      DBNavigator1.visible:=False;
  325.      Memo1.visible:=False;
  326.      Memo2.visible := True;
  327.  end;
  328.  
  329. end;
  330.  
  331. function TForm1.GetDir: string; { called below and in GetDummyFileName }
  332. begin
  333.   Result := DL.Directory;
  334.   if Copy(Result,Length(Result),1)<>'\' then { not already \'d? }
  335.     Result := Result+'\';
  336. end;
  337.  
  338. { V1.5 check: Remove a V1.0 archive file if it is there... }
  339. procedure TForm1.CheckArchiveFile;
  340. var fa: Longint;
  341. begin
  342.   fa := FileAge(ArchiveFile.Text);
  343.   if (fa<>-1) and (fa < 522890500) then { must be v1.0 -- kill it }
  344.       DeleteFile(ArchiveFile.Text);
  345. end;
  346.  
  347. procedure TForm1.archivefileChange(Sender: TObject);
  348. begin
  349.   CheckArchiveFile; { remove old V1.0 archive if we find it is one }
  350.   showfiles;
  351. end;
  352.  
  353. function TForm1.getCompressionMethod: TCompressionMethod;
  354. begin
  355.    result := coNone; { default }
  356.    case CMethod.ItemIndex of
  357.      1: result := coRLE;
  358.      2: result := coLZH;
  359.    end;
  360. end;
  361.  
  362. procedure TForm1.CMethodClick(Sender: TObject);
  363. var meth: TCompressionMethod;
  364. begin
  365.   CDBIMage1.CompressionMethod := getCompressionMethod;
  366.   CDBMemo1.CompressionMethod := getCompressionMethod;
  367. end;
  368.  
  369. procedure TForm1.DLDragOver(Sender, Source: TObject; X, Y: Integer;
  370.   State: TDragState; var Accept: Boolean);
  371. begin
  372.   accept := True;
  373.   if ((Sender is TDirectoryListBox) and (Source is TFileListBox)) or
  374.      (Source=Trashcan) then
  375.         accept := False; { fair enough? }
  376. end;
  377.  
  378. procedure TForm1.CDBMemo1DragOver(Sender, Source: TObject; X, Y: Integer;
  379.   State: TDragState; var Accept: Boolean);
  380. begin
  381.   accept := (Source is TFileListBox) or (Source is TListBox);
  382. end;
  383.  
  384. procedure TForm1.CDBImage1DragOver(Sender, Source: TObject; X, Y: Integer;
  385.   State: TDragState; var Accept: Boolean);
  386. begin
  387.   accept := (Source=Image1) or (Source is TCDBImage) or
  388.      (Source is TFileListBox) or (Source is TListBox);
  389. end;
  390.  
  391. procedure TForm1.archivefileDragOver(Sender, Source: TObject; X,
  392.   Y: Integer; State: TDragState; var Accept: Boolean);
  393. begin
  394.   accept := True; { but... }
  395.   if ((Source is TGroupBox) and not (Sender is TGroupBox)) or
  396.          (((Sender is TEdit)or (Sender is TGroupBox)) and (Source is TListBox)) or { not from our OWN list }
  397.            (Source=Trashcan) then
  398.      accept := False;
  399. end;
  400.  
  401. { Used to create 'work' filenames for saving images and memos
  402.   from the database into our archive or to disk... }
  403. function TForm1.GetDummyFilename(generatefrom: string; ext: string): string;
  404. var spos:Integer;
  405. begin
  406.   if (generatefrom='Image') or (generateFrom='') then
  407.      generatefrom:='image'
  408.   else
  409.   begin
  410.      generatefrom := copy(generatefrom,1,8); { max 8 }
  411.      spos:=pos(' ',generateFrom);
  412.      while spos >0 do { eliminate spaces }
  413.      begin
  414.         delete(generatefrom,spos,1);
  415.        spos:=pos(' ',generateFrom);
  416.      end;
  417.   end;
  418.   result := AnsiLowerCase(Getdir+generatefrom+'.'+ext);
  419. end;
  420.  
  421. function Confirmfilename(filename: String; archiving: Boolean): Boolean;
  422. var dlg: Integer;
  423. begin
  424.   Result := True; { default for archiving }
  425.   if (not Archiving) and
  426.      (MessageDlg('Save to '+filename+'?', mtConfirmation,[mbYes, mbNo], 0)<>id_Yes) then
  427.      Result := False;
  428. end;
  429.  
  430. { The handler for dropping things on the file list or archive list }
  431. procedure TForm1.handleDropField(Source: TObject; archivetoo: Boolean);
  432. var filename: String;
  433. begin
  434.   filename := ''; { in case it is NOT one of those below... }
  435.   if Source is TCDBMemo then
  436.   begin
  437.      filename := GetDummyFilename(Fishname.Text,'TXT');
  438.      if not confirmFilename(filename,archivetoo) then exit;
  439.      CDBMemo1.Lines.SaveToFile(filename);
  440.   end else if Source is TCDBImage then
  441.   begin
  442.      filename := GetDummyFilename(Fishname.Text,'BMP');
  443.      if not confirmFilename(filename,Archivetoo) then exit;
  444.      CDBImage1.Picture.Bitmap.SaveToFile(filename);
  445.   end else if Source = Image1 then
  446.   begin
  447.      filename := GetDummyFilename('Image','BMP');
  448.      if not confirmFilename(filename,Archivetoo) then exit;
  449.      Image1.Picture.Bitmap.SaveToFile(filename);
  450.   end;
  451.   if (filename<>'') and (ArchiveToo) then
  452.       CompressOneFile(filename);
  453. end;
  454.  
  455.  
  456. procedure TForm1.archivefileDragDrop(Sender, Source: TObject; X,
  457.   Y: Integer);
  458. begin
  459.   if Source is TFileListBox then
  460.      CompressFiles
  461.   else
  462.     HandleDropField(Source, True); { save to temp file AND archive... }
  463. end;
  464.  
  465. procedure TForm1.DLDragDrop(Sender, Source: TObject; X, Y: Integer);
  466. var dlg: Integer;
  467. begin
  468.   if Source=Sender then exit; { seems reasonable, and IS necessary }
  469.   if Source is TListBox then
  470.     ExpandDelete(cmExpand,False) { selected archive files }
  471.   else if Source=ArchiveGroup then
  472.      ExpandDelete(cmExpand,True) { all archived files }
  473.   else
  474.     HandleDropField(Source, False); { save field to a file }
  475.   FL.Update; { get up to date... }
  476. end;
  477. procedure TForm1.TrashcanDragDrop(Sender, Source: TObject; X, Y: Integer);
  478. var count: Integer;
  479.     tempBitmap: TBitMap; { just to get an empty one }
  480. begin
  481.   if Source is TListBox then
  482.     ExpandDelete(cmDelete,False)
  483.   else if Source=ArchiveGroup then
  484.      ExpandDelete(cmDelete,True) { all files }
  485.      { and strictly speaking, should now delete the archive if it is
  486.        empty, but I'll leave that as an exercise... }
  487.   else if Source is TFileListBox then { delete some or all... }
  488.   begin
  489.      for count:=0 to FL.Items.count-1 do
  490.         if FL.selected[count] and
  491.            (MessageDlg('Delete '+GetDir+FL.Items[count],mtConfirmation,[mbYes,mbNo],0)=id_Yes) then
  492.            DeleteFile(GetDir+FL.Items[count]);
  493.      FL.Update;
  494.   end
  495.   else if (Source is TCDBMemo) and
  496.               (MessageDlg('Cut to clipboard?',mtConfirmation,[mbYes,mbNo],0)=id_Yes) then
  497.   begin
  498.      CDBMemo1.SelectAll;
  499.      CDBMemo1.cutToClipboard { safer than .clear, for demo purposes }
  500.   end
  501.   else if (Source is TCDBImage) and
  502.             (MessageDlg('Cut to clipboard?',mtConfirmation,[mbYes,mbNo],0)=id_Yes) then
  503.       CDBImage1.cutToClipboard { not quite a delete, but just for example... }
  504.   else if Source=Image1 then
  505.   begin
  506.      tempBitMap := TBitMap.Create;
  507.      try
  508.         Image1.Picture.Bitmap.Assign(tempBitMap);
  509.         Memo1.visible := True
  510.      finally
  511.         tempBitMap.free;
  512.      end;
  513.   end;
  514.  
  515.  
  516. end;
  517.  
  518. procedure TForm1.FormDestroy(Sender: TObject);
  519. var count: Integer;
  520. begin
  521.   if FileList<> nil then
  522.     for count:= 0 to FileList.count-1 do
  523.      Filelist.objects[count].free; { get rid of these (if any)... }
  524.   FileList.free; { and the list itself }
  525. end;
  526.  
  527.  
  528. procedure TForm1.ListBox1Click(Sender: TObject);
  529. var cfinfo: TCompressedFileInfo;
  530. begin
  531.   if listBox1.ItemIndex >=0 then
  532.   begin
  533.      CMethod.Color := ShowFileInfoColor; { make it clear we are showing off a bit... }
  534.      Percentage.Color := ShowFileInfoColor;
  535.      Time.Color := ShowFileInfoColor;
  536.      TimeLabel.Caption := 'Full Size:';
  537.  
  538.      cfinfo:=TCompressedFileinfo(FileList.objects[listBox1.ItemIndex]); { how to get at the other stuff... }
  539.      if cfinfo.Fullsize>0 then
  540.        Percentage.caption:=IntToStr(100-100*cfinfo.CompressedSize div cfinfo.Fullsize)+'%'
  541.      else
  542.        Percentage.caption:='(empty)';
  543.      Time.caption:= IntToStr((512+cfinfo.Fullsize) div 1024)+' Kb';
  544.      if saveCompressionMethod <0 then
  545.         savecompressionMethod :=cMethod.ItemIndex;
  546.      cMethod.ItemIndex :=Integer(cfinfo.CompressedMode);
  547.   end;
  548. end;
  549.  
  550. procedure TForm1.ResetFileInfo;
  551. begin
  552.   if saveCompressionMethod <0 then exit;
  553.   cMethod.ItemIndex:=savecompressionMethod;
  554.   saveCompressionMethod := -1;
  555.   CMethod.Color := clBtnFace;
  556.   Percentage.Color := clWindow;
  557.   Time.Color := clWindow;
  558.   TimeLabel.Caption := 'Time:';
  559.   showInfo; { get the right stuff too... }
  560.   Time.Caption:=''; { but this is meaningless at this point... }
  561. end;
  562.  
  563. { Refreshing a CDBImage so it will be compressed (assuming previously uncompressed) }
  564. procedure TForm1.CDBImage1MouseDown(Sender: TObject; Button: TMouseButton;
  565.   Shift: TShiftState; X, Y: Integer);
  566. begin
  567.   if Button=mbRight then { ok, refresh our field }
  568.   begin
  569.      CDBImage1.CopyToClipBoard;
  570.      CDBImage1.PasteFromClipBoard;
  571.      Table1.post;
  572.   end;
  573. end;
  574.  
  575. procedure TForm1.CDBMemo1MouseDown(Sender: TObject; Button: TMouseButton;
  576.   Shift: TShiftState; X, Y: Integer);
  577. begin
  578.   if Button=mbRight then { ok, refresh our field }
  579.   begin
  580.      CDBMemo1.Lines[0]:=CDBMemo1.Lines[0]; { setting .Modified doesn't do it... }
  581.      Table1.post;
  582.   end;
  583.  
  584. end;
  585.  
  586. procedure TForm1.Table1AfterPost(DataSet: TDataset);
  587. begin
  588.   Showinfo;
  589. end;
  590.  
  591. procedure TForm1.Button1Click(Sender: TObject);
  592. begin
  593.   ShowMessage('Drag and Drop at will: compression and expansion'+#13+
  594.   'is automatic.'+#13+#13+
  595.   'Uses TCompress, TCDBMemo and TCDBImage.'+#13+#13+
  596.   'Component Registration and License: $NZ70 (appr. $US45)'+#13+
  597.   'South Pacific Information Services Ltd'+#13+
  598.   'Fax: +64-3-384-5138   Email: nzsm@spis.southern.co.nz');
  599. end;
  600.  
  601. procedure TForm1.FLClick(Sender: TObject);
  602. begin
  603. ResetFileInfo;
  604. end;
  605.  
  606. procedure TForm1.Compress1CheckFile(var filepath: OpenString;
  607.   mode: TCProcessMode);
  608. var modestr: String;
  609.   dlg: Integer;
  610. begin
  611.   case mode of
  612.      cmExpand: begin
  613.                  modestr := 'Expand';
  614.                  filepath:=Getdir+extractfilename(filepath); { go where we should }
  615.                end;
  616.      cmCompress: begin
  617.                     modestr := 'Compress';
  618.                     filepath:={Getdir+}extractfilename(filepath); { use GetDir if you want full path... }
  619.                  end;
  620.      cmDelete: modestr := 'Delete';
  621.   end;
  622.   showInfo;
  623.   Screen.cursor := crDefault; { in case this is second call in a sequence }
  624.   dlg := MessageDlg(modestr+' '+filepath+'?', mtConfirmation,[mbYes, mbNo, mbCancel], 0);
  625.   case dlg of
  626.      id_No: filepath :=CompressSkipFlag; { flag 'not this one'}
  627.      id_Cancel: filepath :=CompressNoMoreFlag; { flag 'no more!' }
  628.      id_Yes: Screen.Cursor := crHourGlass; { for operation itself }
  629.   end;
  630. end;
  631.  
  632. procedure TForm1.Panel1Click(Sender: TObject);
  633. begin
  634. ResetFileInfo;
  635. end;
  636.  
  637. procedure TForm1.FormClick(Sender: TObject);
  638. begin
  639. ResetFileInfo;
  640. end;
  641.  
  642. procedure TForm1.GroupBox1Click(Sender: TObject);
  643. begin
  644. ResetFileInfo;
  645. end;
  646.  
  647. procedure TForm1.TrashcanDragOver(Sender, Source: TObject; X, Y: Integer;
  648.   State: TDragState; var Accept: Boolean);
  649. begin
  650.   accept := True;
  651. end;
  652.  
  653. procedure TForm1.Button2Click(Sender: TObject);
  654. begin
  655. Application.HelpFile:='COMPRESS.HLP';
  656. Application.HelpJump('1050');
  657. end;
  658.  
  659. end.
  660.